Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/magict_1/form1.frm

Visual Basic Form | 1999-07-22 | 11.0 KB | 338 lines

VERSION 5.00
Object = "{3035B5D2-295D-11D3-8C54-006008BA8D16}#1.0#0"; "MAGICTCP.OCX"
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   9360
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   13830
   LinkTopic       =   "Form1"
   ScaleHeight     =   9360
   ScaleWidth      =   13830
   StartUpPosition =   3  'Windows-Standard
   WindowState     =   2  'Maximiert
   Begin VB.CommandButton txtEnd
      Caption         =   "End"
      Height          =   495
      Left            =   1680
      TabIndex        =   2
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton cmdClear
      Caption         =   "Clear"
      Height          =   495
      Left            =   240
      TabIndex        =   1
      Top             =   120
      Width           =   1335
   End
   Begin VB.TextBox txtInfo
      BeginProperty Font
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   8595
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Beides
      TabIndex        =   0
      Top             =   720
      Width           =   11415
   End
   Begin M3LibCtl.MagicTCP Magic
      Left            =   3960
      OleObjectBlob   =   "Form1.frx":0000
      Top             =   120
   End
   Begin VB.Label Label1
      Alignment       =   1  'Rechts
      Caption         =   "Copyright 1999, hiNRGware, All rights reserved!"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6840
      TabIndex        =   3
      Top             =   240
      Width           =   4575
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const CONN_CLIENT = 1   ' Connection from client (web browser)
Const CONN_SERVER = 2   ' connection to web server / proxy server
' Shall we connect indirectly via a proxy server (cascaded proxies)?
Dim ProxyServer As String
Dim ProxyPort As Long
Private Sub Cleanup()
With Magic
    .Delete .CurrentSocket
End With
End Sub
Private Sub Log(Evt As String)
Dim i As Integer
Dim s As String
s = txtInfo & "[" & Magic.CurrentSocket & "]" & Evt & vbCrLf
While Len(s) > 32000
    i = InStr(s, vbCrLf)
    If (i > 0) Then
        s = Mid(s, i + Len(vbCrLf))
    Else
        s = ""
    End If
txtInfo = s
txtInfo.SelStart = Len(s) + 1
End Sub
Private Sub cmdClear_Click()
txtInfo = ""
End Sub
Private Sub Form_Load()
Dim tf As Boolean 'tf means True/False
With Magic
    .LogEnable = True
    .LogFile = "C:\TEMP\MAGICTCP.TXT"
    'Socket 0 is created automatically.
    ' So we cab start right away by setting up the listening socket :)
    ' Check if a proxy is specfied, where this proxy should connect to (casciding)
    ProxyServer = .GetProfileString("PROXY", "PROXYSERVER", "")
    ProxyPort = .GetProfileInt("PROXY", "PROXYPORT", 0)
    ' Listen on port 8080 (by defualt) for incoming connection requests
    .LocalPort = .GetProfileInt("PROXY", "PORT", 8080)
    .ReUseAddr = True
    ' Let's listen
    tf = .Listen
    ' Something went wrong?
    If Not tf Then
        MsgBox "Listen_Error: " & .LastErrorText
    End If
End With
End Sub
Private Sub Magic_OnAccept(ByVal ListenSocket As Long)
With Magic
    ' new connection accepted. don't do anything here. Wait for data to arrive! See OnRead()
    .zzType = CONN_CLIENT
    ' no data from client read so far
    .zzBuffer = ""
    .LogSocket = True
End With
End Sub
Private Sub Magic_OnClose()
With Magic
    ' delete current socket and it's partner socket
    .Delete .CurrentSocket
End With
End Sub
Private Sub Magic_OnConnect()
' successfull connected. wait for the OnWrite() event to write data to distant host.
End Sub
Private Sub Magic_OnError(ByVal WinsockError As Long, ByVal Func As String)
With Magic
    ' Don't care for asyncronous errors
    '
    ' delete current socket and it's partner socket
    .Delete .CurrentSocket
End With
End Sub
Private Sub Magic_OnRead()
' data from client has arrived!
' the web browser send an http requests, it's first line has the following structure:
' OPERATION http://hostname.anywhere.com/path/file?param=dontcare HTTP/1.x <cr> <lf>
' we'll connect to specified host, and route the rest of the request and the full response
Dim tf As Boolean
Dim take As Boolean
Dim s As String
Dim i As Integer
Dim currSock As Long
Dim newSock As Long
Dim hostname As String
Dim hostport As Long
With Magic
    tf = True                       ' no error so far
    take = False                    ' first line is not complete yet
    newSock = -1                    ' no new socket created
    currSock = .CurrentSocket       ' remember number of current socket
    If tf Then
        ' try to read the first line
        If Not .IsValidSocket(currSock) Then
            MsgBox "Error!!!!!!"
        End If

        If Not .ReadString(s) Then
            tf = False
            Log "Read-Error: " & .LastErrorText
        End If
    End If
    If tf Then
        ' try to isolate the first line which is terminated by <CR> <LF>
        s = .zzBuffer & s
        i = InStr(s, vbCrLf)
        If i > 0 Then
            take = True                     ' first line is complete
            hostname = Left$(s, i - 1)
        Else
            ' first line is not complete. wait for the the next read event. data already received
            ' is stored in the socket's zzBuffer
            .zzBuffer = s
        End If
    End If
    If (tf And take) Then
        ' let's log the request on the user interface
        Log .RemoteHost & ":" & .RemotePort & " " & hostname

        ' no proxy server for our operation definied?
        If (Len(ProxyServer) = 0) Then
            ' extract the hostname (and port) from the HTTP-request

            i = InStr(1, hostname, " ")
            If (i > 0) Then
                hostname = LTrim$(Mid$(hostname, i + 1))
                i = InStr(1, hostname, "//")

                If (i > 0) Then
                    hostname = LTrim$(Mid$(hostname, i + 2))
                    i = InStr(1, hostname, "/")
                End If

                If (i = 0) Then
                    i = InStr(1, hostname, " ")
                End If
            End If


            If (i > 0) Then
                hostname = Left$(hostname, i - 1)
                i = InStr(1, hostname, ":")
                If (i = 0) Then
                    hostport = 80
                Else
                    hostport = CLng(Mid$(hostname, i + 1))
                    hostname = Left$(hostname, i - 1)
                End If
            Else
                tf = False
            End If
        Else
            hostname = ProxyServer
            hostport = ProxyPort
        End If
    End If
    If (tf And take) Then
        ' do not receive any more data until connected from client
        .OnReadEvent = False

        ' create a new socket and define this socket as our partner socket
        newSock = .New
        .PartnerSocket = newSock

        ' switch to the new socket and set it's partner socket as well
        .CurrentSocket = newSock
        .PartnerSocket = currSock
        .OnReadEvent = False

        ' store data already read with the new socket and mark it as outgoing connection
        .zzBuffer = s
        .zzType = CONN_SERVER

        ' set destination for Connect()
        .RemoteHost = hostname
        .RemotePort = hostport

        ' Connect to remote host
        If Not .Connect() Then
            ' failure!
            ' A WOULDBLOCK is ignored since this is nor real error.
            If Not .WouldBlock Then
                'other error!
                tf = False
                Log "Connect-Error: " & .LastErrorText
            End If
        End If
    End If
    ' if an error occured, delete this socket (an it's partner)
    If Not tf Then
        .Delete currSock
    End If
End With
End Sub
Private Sub Magic_OnWrite()
Dim tf As Boolean
Dim s As String
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim currSock As Long
With Magic
    ' relevant only for outgoing connecetions.
    ' we have to forward the data read so far from the client to the web server / proxy
    ' after this, we can activate forwaring between client and server,
    ' since we do not need to parse any data anymore
    If .zzType = CONN_SERVER Then
        tf = True       ' no error so far
        s = .zzBuffer   ' data read so far
        currSock = .CurrentSocket   ' remember current socket

        ' if the remote server is not a proxy, we have to drop the hostname from the HTTP-request
        If tf And (Len(ProxyServer) = 0) Then
            a = InStr(1, s, " ")

            If (a > 0) Then
                b = InStr(a + 1, s, "//")
            End If

            If (b > 0) Then
                c = InStr(b + 2, s, "/")
            End If

            If (c > 0) Then
                s = Left$(s, a) & Mid$(s, c)
            Else
                tf = False
            End If
        End If

        If tf Then
            ' write all client data read so far to the server
            tf = .WriteStringEx(s)
            If Not tf Then
                Log "Write-Error: " & .LastErrorText
            End If
        End If

        If tf Then
            ' no error so far
            ' let's start data forwarding between client and server
            '.Forward .PartnerSocket, True

            ' forward all data to the partner socket
            .ForwardSocket = .PartnerSocket

            ' switch to partner socket and forward all of it's incoming data back to the client
            .CurrentSocket = .PartnerSocket
            .ForwardSocket = .PartnerSocket
        End If

        If Not tf Then
            ' delete the current socket on error
            .Delete currSock
        End If
    End If
End With
End Sub
Private Sub txtEnd_Click()
End Sub